home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / inlin219.zip / INLINE.PAS < prev    next >
Pascal/Delphi Source File  |  1988-04-26  |  55KB  |  2,024 lines
  1.                              {Inline27}
  2.  
  3. (*********  Source code Copyright 1986, by L. David Baldwin   *********)
  4.  
  5. {$R-,S-,I+,F-,V-,B-,N-}
  6. {$M 16384,0,655360 }
  7.  
  8. {
  9. 27 Vers 2.19 Fix CMP AX,-1, etc., incorrect in Vers 2.18.
  10. 26 Vers 2.18 Implement the sign extension bit for some instructions
  11. 25 Vers 2.17 Convert to Turbo 4.
  12. 24 Vers 2.16 Change byte size check in MemReg so the likes of
  13.              MOV [DI+$FE],AX will assemble right.
  14.    Allow ',' in DB pseudo op instruction.
  15. 23 Vers 2.15 Fix 'shl cl,1' which assembled as shl cl,cl
  16. 22 Vers 2.14 Change output format to better accomodate map file line numbers.
  17. 21 Vers 2.13 Allow JMP SHORT direct using symbols.
  18. 20 Vers 2.12 Allow CALL and JMP direct using symbols.
  19. 19 Vers 2.11
  20.    Fix bug in CallJmp and ShortJmp which didn't restrict short
  21.    jump range properly.
  22.    Fix bug which didn't allow CALL or JMP register. (CALL BX).
  23. 18 Vers 2.1
  24.    Fix bug in Accum which occasionally messed up IN and OUT instr.
  25.    Fix unintialized function in getnumber for quoted chars.
  26. 17 Vers 2.03
  27.     Change GetSymbol to accept about anything after '>' or '<'
  28.     Add 'NEW' pseudoinstruction.
  29.     Fix serious bug in defaultextension.
  30.     Add Wait_Already to prevent 2 'WAIT's from occuring.
  31.     Use 'tindex<maxbyte' comparison rather than <= which won't work
  32.     with integer comparison in this case.
  33. }
  34.  
  35. PROGRAM Inline_Asm;
  36.  
  37. Const
  38.   CommentColumn = 25;     {column where comments start in object file}
  39.   Symbolleng = 32;        {maximum of 32 char symbols}
  40.   CR = 13; Lf = 10; Tab = 9;
  41.   Maxbyte = MaxInt;
  42.   BigStringSize = 127;
  43.  
  44.   Signon1 : String[32] =
  45.  
  46.             ^M^J'Inline Assembler, Vers 2.19';
  47.  
  48.   Signon2 : String[43] =
  49.  
  50.             ^M^J'(C) Copyright 1986-7 by L. David Baldwin'^M^J;
  51.  
  52. Type
  53.   FileString = String[64];
  54.   SymString = String[Symbolleng];
  55.   IndxReg = (BX, SI, DI, BP, None);
  56.   IndxSet = set of IndxReg;
  57.   PtrType = (BPtr, WPtr, DwPtr, QwPtr, TbPtr, UnkPtr); {keep order}
  58.   String4 = String[4];
  59.   String5 = Array[1..5] of Char;
  60.   Symtype = (Address, Disp8, Disp16, Othersym, EOLsym, Identifier, JmpDist,
  61.     LfBrack, RtBrack, Plus, Comma, STsym);
  62.   Table = Array[0..20] of SymString; {fake}
  63.   BigString = String[BigStringSize]; {125 chars on a turbo line}
  64.   Label_Info_ptr = ^Label_Info;
  65.   Label_Info = Record
  66.                  Name : SymString;
  67.                  ByteCnt : Integer;
  68.                  Next : Label_Info_ptr;
  69.                end;
  70.   Fixup_Info_Ptr = ^Fixup_Info;
  71.   Fixup_Info = Record
  72.                  Name : SymString;
  73.                  Indx, Indx2, Fix_pt : Integer;
  74.                  Jmptype : (Short, Med);
  75.                  Prev, Next : Fixup_Info_Ptr;
  76.                end;
  77.  
  78. Var
  79.   NoAddrs, Aerr, Symbol, TheEnd, NewFnd, St_first,
  80.   Displace, WordSize, Wait_Already : Boolean;
  81.   Addr : Integer;
  82.   Sym : Symtype;
  83.   ModeByte, Reg1, Reg2, W1, W2, Sti_val : Integer;
  84.   SaveOfs, DataVal : Record
  85.                        Symb : Boolean;
  86.                        Sname : SymString;
  87.                        Value : Integer;
  88.                      end;
  89.   IRset : IndxSet;
  90.   Rmm, Md : Integer;
  91.   ByWord : PtrType;
  92.   Byt, SignExt : Byte;
  93.   Tindex, Tindex0, Column, I, ByteCount, LastSlash : Integer;
  94.   TextArray : Array[0..Maxbyte] of Char;
  95.  
  96.   Lsid : SymString;
  97.   Str8 : Array[1..9] of Char; {the following 4 are at the same location}
  98.   Str : String5 Absolute Str8;
  99.   ID2 : Array[1..2] of Char Absolute Str8;
  100.   ID3 : Array[1..3] of Char Absolute Str8;
  101.   UCh, LCh : Char;
  102.   Chi, OldChi : Integer;
  103.   Out, Inn : Text;
  104.  
  105.   Start_Col : Integer;
  106.   St : BigString;
  107.   Firstlabel, Pl : Label_Info_ptr;
  108.   Firstfix, Pf : Fixup_Info_Ptr;
  109.  
  110. {-------------DefaultExtension}
  111. PROCEDURE DefaultExtension(Extension:FileString;Var Infile,Name :FileString);
  112. {Given a filename, infile, add a default extension if none exists. Return
  113.  also the name without any extension.}
  114. Var
  115.  I,J : Integer;
  116.  Temp : FileString;
  117. begin
  118. I:=Pos('..',Infile);
  119. if I=0 then
  120.   Temp:=Infile
  121. else
  122.   begin   {a pathname starting with ..}
  123.   Temp:=Copy(Infile,I+2,64);
  124.   I:=I+1;
  125.   end;
  126. J:=Pos('.',Temp);
  127. if J=0 then
  128.   begin
  129.   Name := Infile;
  130.   Infile:=Infile+'.'+Extension;
  131.   end
  132. else Name:=Copy(Infile,1,I+J-1);
  133. end;
  134.  
  135. {-------------Space}
  136. PROCEDURE Space(N : Integer);
  137. Var I : Integer;
  138. begin for I := 1 to N do Write(' '); end;
  139.  
  140. {-------------Error}
  141. PROCEDURE Error(II : Integer; S : BigString);
  142. begin
  143. if not Aerr then
  144.   begin
  145.   WriteLn(St);
  146.   Space(Start_Col+II-4);
  147.   Write('^Error');
  148.   if Length(S) > 0 then
  149.     begin Write(', '); Write(S); end;
  150.   WriteLn;
  151.   Aerr := True;
  152.   end;
  153. end;
  154.  
  155. {the following are definitions and variables for the parser}
  156. Var
  157.   Segm, NValue : Integer;
  158.   Symname : SymString;
  159. {end of parser defs}
  160.  
  161. {-------------GetCh}
  162. PROCEDURE GetCh;
  163.   {return next char in uch and lch with uch in upper case.}
  164. begin
  165. if Chi <= Ord(St[0]) then LCh := St[Chi] else LCh := Chr(CR);
  166. UCh := UpCase(LCh);
  167. Chi := Chi+1;
  168. end;
  169.  
  170. {-------------SkipSpaces}
  171. PROCEDURE SkipSpaces;
  172. begin
  173. while (UCh = ' ') or (UCh = Chr(Tab)) do GetCh;
  174. end;
  175.  
  176. {-------------GetDec}
  177. FUNCTION GetDec(Var V : Integer) : Boolean;
  178. Const Ssize = 8;
  179. Var
  180.   S : String[Ssize];
  181.   Getd : Boolean;
  182.   Code : Integer;
  183. begin
  184. Getd := False;
  185. S := '';
  186. while (UCh >= '0') and (UCh <= '9') do
  187.   begin
  188.   Getd := True;
  189.   if Ord(S[0]) < Ssize then S := S+UCh;
  190.   GetCh;
  191.   end;
  192. if Getd then
  193.   begin
  194.   Val(S, V, Code);
  195.   if Code <> 0 then Error(Chi, 'Bad number format');
  196.   end;
  197. GetDec := Getd;
  198. end;
  199.  
  200. {-------------GetHex}
  201. FUNCTION GetHex(Var H : Integer) : Boolean;
  202. Var Digit : Integer;        {check for '$' before the call}
  203. begin
  204. H := 0; GetHex := False;
  205. while (UCh in ['A'..'F', '0'..'9']) do
  206.   begin
  207.   GetHex := True;
  208.   if (UCh >= 'A') then Digit := Ord(UCh)-Ord('A')+10
  209.     else Digit := Ord(UCh)-Ord('0');
  210.   if H and $F000 <>0 then Error(Chi, 'Overflow');
  211.   H := (H Shl 4)+Digit;
  212.   GetCh;
  213.   end;
  214. end;
  215.  
  216. {-------------GetNumber}
  217. FUNCTION GetNumber(Var N : Integer) : Boolean;
  218.   {get a number and return it in n}
  219. Var Term : Char;
  220.   Err : Boolean;
  221. begin
  222. N := 0;
  223. if UCh = '(' then GetCh;    {ignore ( }
  224. if (UCh = '''') or (UCh = '"') then
  225.   begin
  226.   GetNumber := True;
  227.   Term := UCh; GetCh; Err := False;
  228.   while (UCh <> Term) and not Err do
  229.     begin
  230.     Err := N and $FF00 <> 0;
  231.     N := (N Shl 8)+Ord(LCh);
  232.     GetCh;
  233.     if Err then Error(Chi, 'Overflow');
  234.     end;
  235.   GetCh;                    {use up termination char}
  236.   end
  237. else if UCh = '$' then
  238.   begin                     {a hex number}
  239.   GetCh;
  240.   if not GetHex(N) then Error(Chi, 'Hex number exp');
  241.   GetNumber := True;
  242.   end
  243. else
  244.   GetNumber := GetDec(N);   {maybe a decimal number}
  245. if UCh = ')' then GetCh;    {ignore an ending parenthesis}
  246. end;
  247.  
  248. {-------------GetExpr}
  249. FUNCTION GetExpr(Var Rslt : Integer) : Boolean;
  250. Var
  251.   Rs1, Rs2, SaveChi : Integer;
  252.   Pos, Neg : Boolean;
  253. begin
  254. SaveChi := Chi;
  255. GetExpr := False;
  256. SkipSpaces;
  257. Neg := UCh = '-';
  258. Pos := UCh = '+';
  259. if Pos or Neg then GetCh;
  260. if GetNumber(Rs1) then
  261.   begin
  262.   GetExpr := True;
  263.   if Neg then Rs1 := -Rs1;
  264.   if (UCh = '+') or (UCh = '-') then
  265.     if GetExpr(Rs2) then
  266.       Rs1 := Rs1+Rs2;       {getexpr will take care of sign}
  267.   Rslt := Rs1;
  268.   end
  269. else
  270.   begin
  271.   Chi := SaveChi-1; GetCh;
  272.   end;
  273. end;
  274.  
  275. {$v+}
  276. {-------------GetSymbol}
  277. FUNCTION GetSymbol(Var S : SymString) : Boolean;
  278. Const Symchars : set of Char = ['A'..'Z', '0'..'9', '_', '+', '-','$','*'];
  279. begin
  280. if UCh in Symchars then
  281.   begin
  282.   GetSymbol := True;
  283.   S[0] := Chr(0);
  284.   while UCh in Symchars do
  285.     begin
  286.     if Ord(S[0]) < Symbolleng then S := S+UCh;
  287.     GetCh;
  288.     end
  289.   end
  290. else GetSymbol := False;
  291. end;
  292. {$v-}
  293.  
  294. {-------------GetAddress}
  295. FUNCTION GetAddress : Boolean;
  296. Var Result : Boolean;
  297.   SaveChi : Integer;
  298. begin
  299. Result := False; SaveChi := Chi;
  300. if GetExpr(Segm) then
  301.   begin
  302.   SkipSpaces;
  303.   if UCh = ':' then
  304.     begin
  305.     GetCh; SkipSpaces;
  306.     Result := GetExpr(NValue);
  307.     end;
  308.   end;
  309. GetAddress := Result;
  310. if not Result then
  311.   begin Chi := SaveChi-1; GetCh; end;
  312. end;
  313.  
  314. {-------------ErrNull}
  315. PROCEDU